home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Mops 2.7 / Mops source / Toolbox classes / Dialog+ < prev    next >
Encoding:
Text File  |  1995-03-09  |  7.6 KB  |  326 lines  |  [TEXT/MSET]
  1. \ Dialog+ - MRH April 87.
  2.  
  3. \ This subclass of Dialog implements modeless dialogs, popup menu support,
  4. \ and other things.
  5.  
  6. \ Nov  87 mrh    Added enabling and disabling of dialogs.
  7. \ July 91 mrh    Migrated some methods to Dialog (now in a module).
  8. \ Mar  95 mrh    Event handlers no longer return a boolean
  9.  
  10.  
  11. need    dialog
  12.  
  13. objPtr    DLG-CHAIN    \ Head of chain of open dialogs.  When
  14.             \ DialogSelect returns TRUE, we search this
  15.             \ chain to find which which one was hit.
  16.  
  17. objPtr    ACTIVE_DLG
  18. objPtr    THIS_DLG    \ These 3 objPtrs will be set to class Dialog+.
  19.  
  20. var    DPTR        clear: dptr
  21.  
  22. handle    TEHDL
  23. \ This is a copy of the textH field of a dialog, if a dialog window
  24. \ is frontmost.  Nil otherwise.  This allows us to call TEidle in the
  25. \ main event loop when necessary, as required for the insertion point
  26. \ to blink.
  27.  
  28. handle    SaveTEhdl        \ Saves TEhdl while we're suspended
  29.  
  30. $ A0  constant    TEXTH_OFFS
  31.  
  32. : SET_TEHDL    \ ( wnd-ptr -- )
  33.         \ wnd-ptr is the (relative) address of the dialog's window,
  34.         \ which is the same as the address of the dialog record itself, 
  35.         \ as the window field comes first.  The corresponding
  36.         \ absolute address is contained in the ivar dlgPtr.
  37.  
  38.     textH_offs +  @  ?dup IF  put: teHdl  ELSE  clear: teHdl  THEN  ;
  39.  
  40.  
  41. :class  DIALOG+  super{ dialog }
  42. record
  43. {    ptr        F-LINK                \ Forward link - ^dlg
  44.     ptr        B-LINK                \ Backward link ditto
  45.     bool    ENABLED?
  46.     ptr        PUM-LINK            \ Link to any pop-up menus
  47. }
  48.  
  49. ' dlg-chain        set_to_class  dialog+
  50. ' active_dlg    set_to_class  dialog+
  51. ' this_dlg        set_to_class  dialog+
  52.  
  53.  
  54. :m F-LINK:    \ ( -- ^dlg )
  55.     get: f-link  ;m
  56.  
  57. \ ( ^dlg -- )
  58. :m SET-F-LINK:        put: f-link  ;m
  59. :m SET-B-LINK:        put: b-link  ;m
  60.  
  61. \ ( -- ^dlg )
  62. :m PUM-LINK:        get: PUM-link  ;m
  63. :m SET-PUM-LINK:    put: PUM-link  ;m
  64.  
  65.  
  66. :m GETNEW:
  67.     nil?: dlgPtr  0EXIT                \ Out if open already
  68.     dlg-chain  put: f-link
  69.     dlg-chain nilP =
  70.     NIF  ^base   set-b-link: dlg-chain  THEN
  71.     ^base -> dlg-chain   clear: b-link
  72.     getnew: super
  73.     get: dlgPtr  set_teHdl
  74.     0 -> actW  ;m            \ Front window is a dialog, not a Mops window
  75.  
  76.  
  77. :m CLOSE:
  78.     nil?: dlgPtr  ?EXIT                \ Out if closed already
  79.     nil?: f-link
  80.     NIF  get: b-link  get: f-link  set-b-link: dialog+  THEN
  81.     nil?: b-link
  82.     NIF        get: f-link  get: b-link  set-f-link: dialog+
  83.     ELSE    get: f-link  -> dlg-chain
  84.     THEN
  85.     clear: teHdl  nilP -> active_dlg  close: super  ;m
  86.  
  87. :m EXEC:        \ ( index -- )
  88.     get: enabled?  if  exec: super  else  drop  then   ;m
  89.  
  90. :m ENABLE:        true  put: enabled?  ;m
  91.  
  92. :m DISABLE:        false  put: enabled?  ;m
  93.  
  94. :m ENABLED?:    get: enabled?  ;m
  95.  
  96.  
  97. :m CLASSINIT:    enable: self   ;m
  98.  
  99. :m DUMP:
  100.     ^base  .h  3 spaces  nil?: dlgPtr  if  ." not "  then  ." open"
  101.     3 spaces  get: enabled?
  102.     if   ." enabled"   else   ." disabled"   then   cr
  103.     get: f-link ." f-link " .h  get: b-link ." b-link " .h
  104.     ."  dlgPtr "  get: dlgPtr .h  cr
  105.     dlg-chain ." dlg-chain " .h   ;m
  106.  
  107. ;class
  108.  
  109. \                =====================================
  110.  
  111. : FIND-DLG  { dlptr -- b }
  112.     dlg-chain -> this_dlg
  113.     BEGIN
  114.         this_dlg nilP =  IF  false  EXIT  THEN
  115.         dlgPtr: this_dlg  dlptr =
  116.         IF  true  EXIT  THEN
  117.         f-link: this_dlg  -> this_dlg
  118.     AGAIN  ;
  119.  
  120.  
  121. : DLGPORT        \ Sets the current grafport to the current dialog.
  122.     dlgPtr: this_dlg  call setPort  ;
  123.  
  124.  
  125. 0    value    EXEC?
  126.  
  127. : MLD-EVT
  128.     word0  fEvent  addr: dptr  addr: theItem
  129.     call DialogSelect  i->l  0<>  -> exec?
  130.     get: dptr  find-dlg  0EXIT
  131.     exec?  0EXIT
  132.     get: theItem  1-  exec: this_dlg  ;
  133.  
  134.  
  135. : CLOSE-DLG        \ ( dlptr -- )
  136.     find-dlg  0exit
  137.     close: this_dlg  ;
  138.  
  139. : IS_DLG_EVT?    \ ( -- b )
  140.     word0  fevent  call IsDialogEvent  i->l  ;
  141.  
  142.  
  143. \ ?TEidle calls TEidle if a modeless dialog with a TE field is current.
  144. \ We have to do this at regular intervals in order to get the insertion
  145. \ point to blink.  If the call is needed, the handle TEhdl won't be nil,
  146. \ and will be a handle to the TE field.   We arrange for this word to be
  147. \ called regularly by having our handler for null events  make the call.
  148.  
  149. : ?TEIDLE
  150.     nil?: teHdl  ?EXIT
  151.     get: teHdl  call TEidle  ;
  152.  
  153. : UPD-EV    appWind?  0EXIT  upd-evt  ;
  154.  
  155. : ACTV-EV    appWind?  0EXIT  actv-evt  ;
  156.  
  157. : NULL-EV    ?TEidle  null-evt  ;
  158.  
  159. : OS-EV        \ When the system sends us Suspend and Resume events, it doesn't
  160.             \ deactivate/activate any windows.  We have to handle it
  161.             \ ourselves.  Here we look after non-modal dialog windows.
  162.             \ Ordinary windows are handled by OS-EVT in file Event.
  163.     OS-evt
  164.     suspend?
  165.     IF    get: TEhdl  put: saveTEhdl
  166.         nil?: TEhdl
  167.         NIF  get: TEhdl  call TEDeactivate  clear: TEhdl  THEN
  168.         EXIT
  169.     THEN
  170.     resume?
  171.     IF    get: saveTEhdl  put: TEhdl
  172.         nil?: TEhdl  NIF  get: TEhdl  call TEActivate  THEN
  173.     THEN   ;
  174.  
  175.  
  176. : ERR    60 beep abort  ;
  177.  
  178. \ We set the drag limit for dialogs at the time the drag is done - this
  179. \ allows the screen size to change while a dialog is up!
  180.  
  181. rect  DRAG-LIMIT
  182.  
  183. : SET_DRAG-LIMIT
  184.     screenbits  put: drag-limit  10 10 inset: drag-limit  ;
  185.  
  186.  
  187. : ENB?        \ ( -- b )  Returns true if WND corresponds to an enabled 
  188.             \            dialog.
  189.     wnd  find-dlg  NIF  false  exit  THEN
  190.     enabled?: this_dlg  ;
  191.  
  192. : ?SELECT    \ Selects the dialog corresponding to WND, if enabled.
  193.     enb?  0EXIT
  194.     wnd  call SelectWindow  ;
  195.  
  196. : ?DRAG        \ Drags the dialog (maybe only if enabled).
  197.     enb?  0EXIT                \ Include if you don't want disabled dlgs draggable
  198.     set_drag-limit
  199.     wnd  where: fEvent
  200.     addr: drag-limit  call DragWindow  ;
  201.  
  202. : ?CLOSE    \ Handles a click in the close box if enabled.
  203.     enb?  0EXIT
  204.     wnd  dup  >r  word0  r>
  205.     where: fEvent  call TrackGoAway  word0
  206.     IF  close-dlg  ELSE  drop  THEN  ;
  207.  
  208.  
  209. : MLD-MOUSE-EVT        \ ( rgn -- )
  210.     \ Handles a click on a dialog window that was not reported
  211.     \ as a dialog event.  It could be select, drag, grow or close.
  212.     \ If the dialog is not enabled, we ignore the click.
  213.     
  214.     SELECT{
  215.         3  IS{    ?select                            }END
  216.         4  IS{    ?drag                            }END
  217.         5  IS{    ( A dialog box can't grow! )     }END
  218.         6  IS{    ?close                            }END
  219.         DEFAULT{  err
  220.     }SELECT  ;
  221.  
  222.  
  223. : MOUSE-EVT+MLD        \ ( -- )
  224.     is_dlg_evt?  IF  MLD-evt  EXIT  THEN
  225.     when: fEvent  put: theMouse            \ update click interval
  226.     where: fEvent  find-window  -> wnd
  227.     wnd windowKind  2 =  ( Dialog window? )
  228.     IF        MLD-mouse-evt
  229.     ELSE    (mouse-evt)
  230.     THEN  ;
  231.  
  232.  
  233. : KEY-EVT+MLD        \ ( -- )
  234.     active_dlg  nilP =
  235.     NIF    key: active_dlg  0EXIT        \ out if already handled
  236.         mods: fEvent  $ 100 and
  237.         NIF  MLD-evt  EXIT  THEN
  238.     THEN
  239.     key-evt  ;
  240.  
  241.  
  242. : UPD-EVT+MLD        \ ( -- )
  243.     is_dlg_evt?
  244.     IF    MLD-evt
  245.         drawBold: this_dlg  EXIT
  246.     THEN
  247.     msg: fEvent  -> wnd
  248.     upd-ev  ;
  249.  
  250.  
  251. : ACTV-EVT+MLD        \ ( -- )
  252.     msg: fEvent  -> wnd
  253.     wnd windowKind  2 =
  254.     IF    mods: fEvent 01 and
  255.         IF                    \ activate
  256.             wnd set_TEhdl
  257.             msg: fEvent  find-dlg
  258.             IF        this_dlg -> active_dlg
  259.             ELSE    nilP -> active_dlg
  260.             THEN
  261.         ELSE                \ deactivate
  262.             clear: TEhdl  nilP -> active_dlg
  263.         THEN
  264.         is_dlg_evt?  IF  MLD-evt  EXIT  THEN
  265.     THEN
  266.     actv-ev  ;
  267.  
  268.  
  269. : +MODELESS
  270.     XTS{    null-ev            mouse-evt+mld    null-ev            key-evt+mld
  271.             null-ev            key-evt+mld        upd-evt+mld        disk-evt
  272.             actv-evt+mld    null-ev            null-ev            null-ev
  273.             null-ev            null-ev            null-ev            OS-ev
  274.             null-ev            null-ev            null-ev            null-ev
  275.             null-ev            null-ev            null-ev            HL-evt  }
  276.     put: fEvent
  277. \    ['] ?TEidle -> TEidle
  278.     sleepticks 0<  IF  20  ELSE  sleepticks  20 min  THEN
  279.     -> sleepticks  ;
  280.  
  281.  
  282. endload
  283.  
  284. \ TESTING:
  285.  
  286. \ ================== "MLD test" dialog box ==========================
  287.  
  288.     6    dialog+    D1        2 setbold: d1
  289.     4    dialog+    D2
  290.  
  291.  
  292. : QQQ        20 beep  ;
  293. : WWW         1 beep  ;
  294. : ZZZ        ." useritem hit" cr  ;
  295.  
  296.  
  297. : USER->TEMPRECT    \ ( hdl w:item# -- b )
  298.     i->l swap  find-dlg
  299.     IF        itemHandle: this_dlg  drop  true
  300.     ELSE    ( item# )  drop  false
  301.     THEN  ;
  302.  
  303.  
  304. :proc  DRAW_USER
  305.     user->tempRect
  306.     IF    " Hello"  tempRect 1 makeint call textBox
  307.         dropShadow: tempRect
  308.     THEN   ;proc
  309.  
  310.  
  311.  
  312. : CLOSE1    close: d1  ;
  313. : CLOSE2    close: d2  ;
  314.  
  315. XTS{  qqq www close1 togitem  zzz  zzz  }    300  init: d1
  316. XTS{  qqq www close2  zzz                }    301  init: d2
  317.  
  318. : GO
  319.     " MLDtest.rsrc" openresfile        \ ***
  320.     +modeless
  321.     getnew: d1  getnew: d2
  322.     ['] draw_user dup 6 setUserProc: d1  dup 5 setUserProc: d1
  323.     4 setUserProc: d2  ;
  324.  
  325. : zz  close: d1  close: d2  -modeless  ;
  326.